﻿Public Class DateBox : Inherits ComboBox

	Sub New()
		MyBase.New()
		SmartFormatting = True
		List = False
	End Sub

	Public Overrides Property Value() As Object
		Get
			Dim ControlValue As String = (Mid(Text, 7, 4) & "." & Mid(Text, 4, 2) & "." & Mid(Text, 1, 2))
			If Not IsDate(ControlValue) Then Return DBNull.Value
			Return CDate(ControlValue)
		End Get
		Set(ByVal Value As Object)
			If IsDBNull(Value) Then Value = ""
			If IsDate(Value) Then
				Dim Sep As String = Threading.Thread.CurrentThread.CurrentCulture.DateTimeFormat.DateSeparator
				Text = Replace(String.Format(Value, "dd/MM/yyyy"), Sep, "/")
			ElseIf Len(Value) = 8 Then
				Text = Mid(Value, 7, 2) & "/" & Mid(Value, 5, 2) & "/" & Mid(Value, 1, 4)
			ElseIf Len(Value) = 10 Then
				Text = Mid(Value, 1, 2) & "/" & Mid(Value, 4, 2) & "/" & Mid(Value, 7, 4)
			Else
				Text = "__/__/____"
			End If
		End Set
	End Property

	Private Sub DateBox_TextChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.TextChanged
		RaiseChangeEvent()
	End Sub

	Private Sub DateBox_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
		Select Case e.KeyCode
			Case Keys.Left
				FocusDateChar(SelectionStart, -1)
				e.Handled = True
			Case Keys.Right
				FocusDateChar(SelectionStart, 1)
				e.Handled = True
			Case Keys.Back
				If Me.ReadOnly Then Exit Sub
				If SelectionLength > 1 Then
					Mid(Text, SelectionStart + 1, SelectionLength) = Mid("__/__/_____", SelectionStart + 1, SelectionLength)
				Else
					FocusDateChar(SelectionStart, -1)
					SelectedText = "_"
					FocusDateChar(SelectionStart, -1)
				End If
				e.Handled = True
			Case Keys.Delete
				If Me.ReadOnly Then Exit Sub
				If SelectionLength > 0 Then
					Mid(Text, SelectionStart + 1, SelectionLength) = Mid("__/__/_____", SelectionStart + 1, SelectionLength)
				Else
					FocusDateChar(SelectionStart, 0)
					SelectedText = "_"
					FocusDateChar(SelectionStart - 1, 0)
				End If
				e.Handled = True
		End Select
	End Sub

	Protected Overrides Sub OnKeyPress(e As System.Windows.Forms.KeyPressEventArgs)
		If e.Handled Then Return
		If Me.ReadOnly Then Exit Sub
		If InStr("0123456789", e.KeyChar) > 0 Then
			FocusDateChar(SelectionStart, 0)
			If SelectionStart = 3 AndAlso e.KeyChar > "1" Then
				SelectionLength += 1
				SelectedText = "0" & e.KeyChar
				FocusDateChar(SelectionStart + 1, 0)
				e.Handled = True
			Else
				If SelectedText <> "" Then SelectedText = e.KeyChar
				FocusDateChar(SelectionStart, 0)
				e.Handled = True
			End If
		ElseIf e.KeyChar = Chr(8) Then
			e.Handled = True
		End If
		'MyBase.OnKeyPress(e)
	End Sub

	Private Sub FocusDateChar(ByVal Index, ByVal Offset)
		Index = Index + Offset
		If Index < 0 Then Exit Sub
		If Index > 10 Then Exit Sub
		If Offset >= 0 Then
			SelectionStart = Choose(Index + 1, 0, 1, 3, 3, 4, 6, 6, 7, 8, 9, 10)
		Else
			SelectionStart = Choose(Index + 1, 0, 1, 1, 3, 4, 4, 6, 7, 8, 9, 10)
		End If
		SelectionLength = 1
	End Sub

	Public Overrides ReadOnly Property IsEmpty() As Boolean
		Get
			If Text = "__/__/____" Then Return True
			If Not IsValid Then Return True
		End Get
	End Property

	ReadOnly Property IsValid() As Boolean
		Get
			Dim ControlValue As String = (Mid(Text, 7, 4) & "." & Mid(Text, 4, 2) & "." & Mid(Text, 1, 2))
			If Not IsDate(ControlValue) Then Return False
			Return True
		End Get
	End Property

	Public Overrides Function Errors() As String
		If IsRequired AndAlso IsEmpty Then Return Caption & " alanı boş olamaz."
		If Not IsEmpty AndAlso Not IsValid Then Return Caption & " alanı geçersiz bir tarih içeriyor."
		Return ""
	End Function

	Public Overrides Function GetDropDownControl() As System.Windows.Forms.Control
		Dim Calendar As New Calendar
		If Not IsDBNull(Value) Then Calendar.Value = Value
		AddHandler Calendar.DateSelected, AddressOf SelectDate
		Return Calendar
	End Function

	Sub SelectDate(sender As Object)
		Value = sender.Value
		CloseMenu()
		RaiseChangeEvent()
	End Sub

	Public Overrides Sub Reset()
		MyBase.Reset()
		Value = [Default]
	End Sub

End Class

Public Class Calendar : Inherits UserControl
	Dim w As Integer = 24
	Dim h As Integer = 18
	Dim th As Integer = 25
	Dim Level As Integer = 0

	Sub New()
		DoubleBuffered = True
		MinimumSize = New Size(0, 0)
		MaximumSize = New Size(0, 0)
		MinimumSize = New Size((w + 1) * 7 - 2, (h + 1) * 7 - 2 + th)
		MaximumSize = MinimumSize
		Size = MinimumSize
	End Sub

	Dim _Value As Nullable(Of Date)
	Property Value As Nullable(Of Date)
		Get
			Return _Value
		End Get
		Set(Value As Nullable(Of Date))
			_Value = Value
			_SelectedDate = Value
			Invalidate()
		End Set
	End Property

	Dim _SelectedDate As Date = Today.Date
	Property SelectedDate As Date
		Get
			Return _SelectedDate
		End Get
		Set(value As Date)
			_SelectedDate = value
			Invalidate()
		End Set
	End Property

	Protected Overrides Sub OnEnter(e As System.EventArgs)
		MyBase.OnEnter(e)
		SelectedDate = If(IsNothing(Value), Today.Date, Value)
	End Sub

	Dim Rects As New SortedList(Of String, Rectangle)

	Dim _HoverRect As Rectangle
	Property HoverRect As Rectangle
		Get
			Return _HoverRect
		End Get
		Set(value As Rectangle)
			_HoverRect = value
			If Not value = Rectangle.Empty Then
				Cursor = Cursors.Hand
			Else
				Cursor = Cursors.Default
			End If
			Invalidate()
		End Set
	End Property

	Dim WithEvents Timer As New Timer With {.Interval = 250}

	Protected Overrides Sub OnPaint(e As System.Windows.Forms.PaintEventArgs)
		MyBase.OnPaint(e)
		Rects.Clear()
		Dim Rect As Rectangle = ClientRectangle
		Dim R As Rectangle = Rect
		R.Height = th - 2
		e.Graphics.FillRectangle(Brushes.Black, R)
		R.Inflate(-16, 0)
		Rects.Add("t", R)
		Dim T As String = ""
		Select Case Level
			Case "0" : T = MonthName(SelectedDate.Month) & " " & Year(SelectedDate)
			Case "1" : T = Year(SelectedDate)
			Case "2" : T = Mid(Year(SelectedDate), 1, 3) & "0 - " & Mid(Year(SelectedDate), 1, 3) & "9"
		End Select
		TextRenderer.DrawText(e.Graphics, T, Font, R, If(HoverRect = R, Color.Yellow, Color.White), Color.Transparent, TextFormatFlags.HorizontalCenter + TextFormatFlags.VerticalCenter)
		R.Inflate(16, 0)
		For i As Integer = 1 To 2
			R = New Rectangle(Choose(i, Rect.Left, Rect.Right - th), Rect.Top, th, th)
			R.Inflate(-1, -1)
			TextRenderer.DrawText(e.Graphics, Mid("34", i, 1), New Font("marlett", 9), R, If(HoverRect = R, Color.Yellow, Color.White), Color.Transparent, TextFormatFlags.HorizontalCenter + TextFormatFlags.VerticalCenter)
			Rects.Add("a" & Level & i, R)
		Next
		Rect.Offset(0, th)
		Rect.Height -= th + 1
		Dim d As Date = SelectedDate.AddDays(-SelectedDate.Day + 1)
		d = d.AddDays(-Weekday(d, FirstDayOfWeek.Monday) + 1)
		If Level = 0 Then
			For y As Integer = 0 To 6
				For x As Integer = 0 To 6
					R = New Rectangle(Rect.Left + x * (w + 1) - 1, Rect.Top + y * (h + 1) - 1, w, h)
					If y = 0 Then
						e.Graphics.FillRectangle(SystemBrushes.ButtonFace, R)
						Dim wd As String = "Pt.S.Ç.Pr.C.Ct.P".Split(".")(x)
						TextRenderer.DrawText(e.Graphics, wd, Font, R, Color.Black, Color.Transparent, TextFormatFlags.HorizontalCenter + TextFormatFlags.VerticalCenter)
					Else
						Rects.Add(d, R)
						e.Graphics.FillRectangle(Brushes.White, R)
						If d.Month = SelectedDate.Month Then
							TextRenderer.DrawText(e.Graphics, d.Day, Font, R, Color.Black, Color.Transparent, TextFormatFlags.HorizontalCenter + TextFormatFlags.VerticalCenter)
						Else
							TextRenderer.DrawText(e.Graphics, d.Day, Font, R, Color.Gray, Color.Transparent, TextFormatFlags.HorizontalCenter + TextFormatFlags.VerticalCenter)
						End If
						If d.DayOfWeek = DayOfWeek.Saturday Or d.DayOfWeek = DayOfWeek.Sunday Then
							e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(64, Color.Black)), R)
						End If
						If d = SelectedDate Then
							e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(128, SystemColors.Highlight)), R)
						End If
						If R = HoverRect Then
							e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(64, SystemColors.Highlight)), R)
						End If
						d = d.AddDays(1)
					End If
				Next
			Next
		ElseIf Level = 1 Then
			Dim w As Integer = (Me.w * 7 + 3) / 4
			Dim h As Integer = (Me.h * 7 + 2) / 3
			For y As Integer = 0 To 2
				For x As Integer = 0 To 3
					R = New Rectangle(Rect.Left + x * (w + 1) - 1, Rect.Top + y * (h + 1) - 1, w, h)
					Rects.Add("m" & Trim(y * 4 + x + 1), R)
					e.Graphics.FillRectangle(Brushes.White, R)
					If y * 4 + x + 1 = SelectedDate.Month Then
						e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(128, SystemColors.Highlight)), R)
					End If
					If R = HoverRect Then
						e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(64, SystemColors.Highlight)), R)
					End If
					TextRenderer.DrawText(e.Graphics, Mid(MonthName(y * 4 + x + 1), 1, 3), Font, R, Color.Black, Color.Transparent, TextFormatFlags.HorizontalCenter + TextFormatFlags.VerticalCenter)
				Next
			Next
		ElseIf Level = 2 Then
			Dim w As Integer = (Me.w * 7 + 3) / 4
			Dim h As Integer = (Me.h * 7 + 2) / 3
			For y As Integer = 0 To 2
				For x As Integer = 0 To 3
					R = New Rectangle(Rect.Left + x * (w + 1) - 1, Rect.Top + y * (h + 1) - 1, w, h)
					Rects.Add("y" & Trim(y * 4 + x), R)
					e.Graphics.FillRectangle(Brushes.White, R)
					If y * 4 + x = SelectedDate.Year Mod 10 Then
						e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(128, SystemColors.Highlight)), R)
					End If
					If R = HoverRect Then
						e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(64, SystemColors.Highlight)), R)
					End If
					TextRenderer.DrawText(e.Graphics, Int(SelectedDate.Year / 10) * 10 + y * 4 + x, Font, R, Color.Black, Color.Transparent, TextFormatFlags.HorizontalCenter + TextFormatFlags.VerticalCenter)
				Next
			Next
		End If
	End Sub

	Protected Overrides Sub OnMouseDown(e As System.Windows.Forms.MouseEventArgs)
		MyBase.OnMouseDown(e)
		If HoverRect = Rectangle.Empty Then Return
		For Each kv As KeyValuePair(Of String, Rectangle) In Rects
			If kv.Value = HoverRect Then
				Dim v = kv.Key
				If v = "t" Then
					If Level < 2 Then Level += 1
					Invalidate()
				ElseIf v = "a01" Then
					SelectedDate = SelectedDate.AddMonths(-1).AddDays(-SelectedDate.Day + 1)
				ElseIf v = "a02" Then
					SelectedDate = SelectedDate.AddMonths(1).AddDays(-SelectedDate.Day + 1)
				ElseIf v = "a11" Then
					SelectedDate = SelectedDate.AddYears(-1).AddDays(-SelectedDate.Day + 1)
				ElseIf v = "a12" Then
					SelectedDate = SelectedDate.AddYears(1).AddDays(-SelectedDate.Day + 1)
				ElseIf v = "a21" Then
					SelectedDate = SelectedDate.AddYears(-10).AddDays(-SelectedDate.Day + 1)
				ElseIf v = "a22" Then
					SelectedDate = SelectedDate.AddYears(10).AddDays(-SelectedDate.Day + 1)
				ElseIf Mid(v, 1, 1) = "m" Then
					Level -= 1
					SelectedDate = New Date(SelectedDate.Year, Mid(v, 2), 1)
				ElseIf Mid(v, 1, 1) = "y" Then
					Level -= 1
					SelectedDate = New Date(Mid(SelectedDate.Year, 1, 3) * 10 + Val(Mid(v, 2)), 1, 1)
				ElseIf IsDate(v) Then
					Value = v
					SelectedDate = v
					RaiseEvent DateSelected(Me)
				End If
				Return
			End If
		Next
	End Sub

	Event DateSelected(sender As Object)

	Protected Overrides Sub OnMouseMove(e As System.Windows.Forms.MouseEventArgs)
		MyBase.OnMouseMove(e)
		For Each R As Rectangle In Rects.Values
			If R.Contains(e.Location) Then
				HoverRect = R
				Return
			End If
		Next
		HoverRect = Rectangle.Empty
	End Sub

	Protected Overrides Sub OnMouseLeave(e As System.EventArgs)
		MyBase.OnMouseLeave(e)
		HoverRect = Rectangle.Empty
	End Sub

	Protected Overrides Function ProcessCmdKey(ByRef msg As System.Windows.Forms.Message, keyData As System.Windows.Forms.Keys) As Boolean
		If keyData = Keys.Return Then
			Select Case Level
				Case 0
					Value = SelectedDate
					RaiseEvent DateSelected(Me)
				Case 1
					Value = SelectedDate
					Level -= 1
					Invalidate()
				Case 2
					Value = SelectedDate
					Level -= 1
					Invalidate()
			End Select
		ElseIf keyData = Keys.Right Then
			Select Case Level
				Case 0 : SelectedDate = SelectedDate.AddDays(1)
				Case 1 : SelectedDate = SelectedDate.AddMonths(1)
				Case 2 : SelectedDate = SelectedDate.AddYears(1)
			End Select
			Return True
		ElseIf keyData = Keys.Left Then
			Select Case Level
				Case 0 : SelectedDate = SelectedDate.AddDays(-1)
				Case 1 : SelectedDate = SelectedDate.AddMonths(-1)
				Case 2 : SelectedDate = SelectedDate.AddYears(-1)
			End Select
			Return True
		ElseIf keyData = Keys.Down Then
			Select Case Level
				Case 0 : SelectedDate = SelectedDate.AddDays(7)
				Case 1 : SelectedDate = SelectedDate.AddMonths(4)
				Case 2 : SelectedDate = SelectedDate.AddYears(4)
			End Select
			Return True
		ElseIf keyData = Keys.Up Then
			Select Case Level
				Case 0 : SelectedDate = SelectedDate.AddDays(-7)
				Case 1 : SelectedDate = SelectedDate.AddMonths(-4)
				Case 2 : SelectedDate = SelectedDate.AddYears(-4)
			End Select
			Return True
		ElseIf keyData = Keys.Control + Keys.Right Then
			Select Case Level
				Case 0 : SelectedDate = SelectedDate.AddMonths(1)
				Case 1 : SelectedDate = SelectedDate.AddYears(1)
			End Select
			Return True
		ElseIf keyData = Keys.Control + Keys.Left Then
			Select Case Level
				Case 0 : SelectedDate = SelectedDate.AddMonths(-1)
				Case 1 : SelectedDate = SelectedDate.AddYears(-1)
			End Select
			Return True
		ElseIf keyData = Keys.Control + Keys.Down Then
			SelectedDate = SelectedDate.AddYears(1)
			Return True
		ElseIf keyData = Keys.Control + Keys.Up Then
			SelectedDate = SelectedDate.AddYears(-1)
			Return True
		ElseIf keyData = Keys.Home Then
			Select Case Level
				Case 0 : SelectedDate = SelectedDate.AddDays(-SelectedDate.Day + 1)
				Case 1 : SelectedDate = SelectedDate.AddMonths(-SelectedDate.Month + 1)
			End Select
			Return True
		ElseIf keyData = Keys.End Then
			Select Case Level
				Case 0 : SelectedDate = SelectedDate.AddMonths(1).AddDays(-SelectedDate.Day)
				Case 1 : SelectedDate = SelectedDate.AddMonths(-SelectedDate.Month + 12)
			End Select
			Return True
		ElseIf keyData = Keys.Add Then
			Level += 1
			Invalidate()
		ElseIf keyData = Keys.Subtract Then
			Level -= 1
			Invalidate()
		End If
		Return MyBase.ProcessCmdKey(msg, keyData)
	End Function

End Class